' targalib.bi is part of Bliss (track editor for Stunts)
' Copyright (C) 2016-2018  Lucas Pedrosa

' Bliss is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, version 3 of the License.

' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License
' along with this program.  If not, see <http://www.gnu.org/licenses/>.


#include once "file.bi"
#define MAX_TARGA_WIDTH 8192
#define MAX_TARGA_HEIGHT 8192

Type TargaHeader Field = 1
	IDlength As UByte
	ColorMapType As UByte
	ImageType As UByte
	ColorMapStart As UShort
	ColorMapLength As UShort
	ColorMapDepth As UByte
	XOffset As UShort
	YOffset As UShort
	ImageWidth As UShort
	ImageHeight As UShort
	PixelDepth As UByte
	ImageDescriptor As UByte
End Type

Dim Shared TargaError As Short, TargaErrorMessage As String

Function TargaLoad(filename As String) As Any Pointer
	'Reset error
	TargaError = 0 : TargaErrorMessage = ""
	
	If Not FileExists(filename) Then
		TargaError = 201
		TargaErrorMessage = "File not found"
		Return 0
	End If

	Dim h As TargaHeader, f As Short
	Dim localdepth As Integer	'Colour depth for current screen mode
	Dim iptr As UByte Ptr	'Pointer to new image being generated
	Dim linelength As Long	'Image line length within iptr in bytes
	Dim imagestart As UByte Ptr	'Pointer to start of image data in iptr
	Dim idatastart As Long	'File pointer to start of image data
	Dim alphachannel As Byte	'Whether there's an alpha channel
	Dim inverted As Byte	'Whether the image goes from bottom to top
	Dim buffer As UByte Ptr		'Where compressed data will be loaded
	Dim wp As Long		'Current write pointer (to image)
	Dim rp As Long		'Current read pointer (from buffer)
	
	'Get current color depth
	ScreenControl 5, localdepth
		
	'Open the file
	f = FreeFile
	Open filename For Binary Access Read As f
	Get #f, 1, h	'Load the header
	
	'Safety maximums have been set
	'You can change these maximums to your preference
	If h.ImageWidth > MAX_TARGA_WIDTH Or h.ImageHeight > MAX_TARGA_HEIGHT Then
		TargaError = 202
		TargaErrorMessage = "Image is too large"
		Close f : Return 0
	End If
	
	'Calculate where image data starts in the file
	idatastart = 19 + h.IDlength
	If h.ColorMapType Then idatastart += h.ColorMapLength * (h.ColorMapDepth \ 8)
	
	'See if image is inverted
	If (h.ImageDescriptor And 32) = 0 Then inverted = -1
	If (h.ImageDescriptor And 16) <> 0 Then
		'X is inverted. Very unusual thing. Not currently supported
		TargaError = 203
		TargaErrorMessage = "Format not supported: X axis is inverted"
		Close f : Return 0
	End If
	
	'See if there's an alpha channel
	If h.ImageDescriptor And 15 Then alphachannel = -1
	
	'Create a buffer of image size
	iptr = ImageCreate(h.ImageWidth, h.ImageHeight, , 32)
	ImageInfo iptr, , , , linelength, imagestart

	'Load all image data from file to a buffer
	buffer = Allocate(LOF(f) - idatastart + 1)
	If buffer = 0 Then
		'Could not allocate memory to load the file
		TargaError = 204
		TargaErrorMessage = "Could not allocate a buffer to decompress image"
		ImageDestroy iptr
		Close f
		Return 0
	End If
	Get #f, idatastart, *buffer, LOF(f) - idatastart + 1
	
	'==== Test for each of the possible supported formats ====
	
	'True colour, RLE compressed, with alpha channel
	If h.PixelDepth = 32 And h.ImageType = 10 And alphachannel <> 0 Then
		Dim As UByte copying, repeating, sample(0 To 3)
		Dim column As Long
		
		rp = 0	'Reset read pointer
		
		'For every line
		For i As Long = 0 To h.ImageHeight - 1
			'Calculate relative start of the line
			If inverted Then
				wp = (h.ImageHeight - i - 1) * linelength
			Else
				wp = i * linelength
			End If
			
			'Starting the line from column zero
			column = 0
			Do
				'Check to see if there's RLE or non-RLE pending
				If repeating Then
					'Repeat one more sample of RLE block
					For j As Byte = 0 To 3
						imagestart[wp + j] = sample(j)
					Next j
					wp += 4
					column += 1
					repeating -= 1
				ElseIf copying Then
					'Copy one more sample from buffer
					For j As Byte = 0 To 3
						imagestart[wp + j] = buffer[rp + j]
					Next j
					wp += 4 : rp += 4
					column += 1
					copying -= 1
				Else
					'Process an RLE/non-RLE header
					copying = buffer[rp]
					rp += 1
					If copying And 128 Then
						repeating = copying - 127
						copying = 0
						For j As Byte = 0 To 3
							sample(j) = buffer[rp + j]
						Next j
						rp += 4
					Else
						copying += 1
					End If
				End If
			Loop Until column = h.ImageWidth
		Next i
	'True colour, RLE compressed, without alpha channel
	ElseIf h.PixelDepth = 24 And h.ImageType = 10 And alphachannel = 0 Then
		Dim As UByte copying, repeating, sample(0 To 3)
		Dim column As Long
		
		rp = 0	'Reset read pointer
		
		'For every line
		For i As Long = 0 To h.ImageHeight - 1
			'Calculate relative start of the line
			If inverted Then
				wp = (h.ImageHeight - i - 1) * linelength
			Else
				wp = i * linelength
			End If
			
			'Starting the line from column zero
			column = 0
			Do
				'Check to see if there's RLE or non-RLE pending
				If repeating Then
					'Repeat one more sample of RLE block
					For j As Byte = 0 To 3
						imagestart[wp + j] = sample(j)
					Next j
					wp += 4
					column += 1
					repeating -= 1
				ElseIf copying Then
					'Copy one more sample from buffer
					For j As Byte = 0 To 2
						imagestart[wp + j] = buffer[rp + j]
					Next j
					imagestart[wp + 3] = 255
					wp += 4 : rp += 3
					column += 1
					copying -= 1
				Else
					'Process an RLE/non-RLE header
					copying = buffer[rp]
					rp += 1
					If copying And 128 Then
						repeating = copying - 127
						copying = 0
						For j As Byte = 0 To 2
							sample(j) = buffer[rp + j]
						Next j
						sample(3) = 255
						rp += 3
					Else
						copying += 1
					End If
				End If
			Loop Until column = h.ImageWidth
		Next i
	'True colour, uncompressed, with alpha channel
	ElseIf h.PixelDepth = 32 And h.ImageType = 2 And alphachannel <> 0 Then
		rp = 0
		
		'For every line
		For i As Long = 0 To h.ImageHeight - 1
			'Calculate relative start of the line
			If inverted Then
				wp = (h.ImageHeight - i - 1) * linelength
			Else
				wp = i * linelength
			End If
			
			For j As Long = 0 To 4 * h.ImageWidth - 1
				imagestart[wp + j] = buffer[rp + j]
			Next j
			rp += 4 * h.ImageWidth
		Next i
	'True colour, uncompressed, without alpha channel
	ElseIf h.PixelDepth = 24 And h.ImageType = 2 And alphachannel = 0 Then
		rp = 0
		
		'For every line
		For i As Long = 0 To h.ImageHeight - 1
			'Calculate relative start of the line
			If inverted Then
				wp = (h.ImageHeight - i - 1) * linelength
			Else
				wp = i * linelength
			End If
			
			For j As Long = 0 To h.ImageWidth - 1
				imagestart[wp + 4 * j] = buffer[rp + 3 * j]
				imagestart[wp + 4 * j + 1] = buffer[rp + 3 * j + 1]
				imagestart[wp + 4 * j + 2] = buffer[rp + 3 * j + 2]
				imagestart[wp + 4 * j + 3] = 255
			Next j
			rp += 3 * h.ImageWidth
		Next i
	Else
		'Unsupported format
		TargaError = 205
		TargaErrorMessage = "Unsupported format"
		Deallocate buffer
		ImageDestroy iptr
		Close f
		Return 0
	End If
	
	Deallocate buffer
	Close f
	
	Return iptr
End Function


Sub TargaSave(filename As String, image As Any Ptr)
	Dim As Integer iwidth, iheight, bypp, linelength
	Dim As ULong Ptr imagestart
		
	'Reset error information
	TargaError = 0 : TargaErrorMessage = ""
	
	'Make sure it's a valid image
	If image = 0 Then
		TargaError = 101
		TargaErrorMessage = "No image in buffer"
		Exit Sub
	End If
	ImageInfo image, iwidth, iheight, bypp, linelength, imagestart

	If bypp <> 4 Then
		TargaError = 102
		TargaErrorMessage = "Not a 32bit image. Unsupported"
		Exit Sub
	End If
	
	'See if the image contains any alpha information
	Dim alphachannel As Byte = 0
	For i As Long = 0 To iwidth * iheight - 1
		If imagestart[i] ShR 24 <> 255 Then
			alphachannel = -1
			Exit For
		End If
	Next i
	
	'Set up image header
	Dim h As TargaHeader, f As Short
	
	If alphachannel Then
		h.PixelDepth = 32
		h.ImageDescriptor = 8
	Else
		h.PixelDepth = 24
		h.ImageDescriptor = 0
	End If
	
	h.ImageType = 10
	h.ImageWidth = iwidth
	h.ImageHeight = iheight

	'Open file
	f = FreeFile
	If Open(filename For Output As f) Then
		TargaError = 103
		TargaErrorMessage = "Failed to create image file"
		Exit Sub
	Else
		Close f
		Open filename For Binary Access Write As f
	End If
	
	'Put header
	Put #f, 1, h
	
	'Compress image row by row
	Dim rp As Long, column As Long, buffer As String
	Dim count As Short, status As Byte, sample As ULong
	
	For i As Long = 0 To iheight - 1	'For every row...
		'Calculate where to read the row from
		rp = (iheight - i - 1) * linelength \ 4
		
		buffer = ""
		column = 0
		status = 0	'Still don't know if RLE or not
		count = 0	'Nothing pending
		Do
			Select Case status
				Case 0 'Undefined
					sample = imagestart[rp + column]
					
					'If it's the last pixel, just push it
					If column = iwidth - 1 Then
						If alphachannel Then
							buffer &= Chr(0) + MkL(sample)
						Else
							buffer &= Chr(0) + Left(MkL(sample), 3)
						End If
						Exit Do
					End If
					
					count = 0
					If sample = imagestart[rp + column + 1] Then
						status = 1	'Building an RLE block
					Else
						status = 2	'Building a non-RLE block
					End If
				Case 1	'RLE
					If imagestart[rp + column] = sample Then
						If count = 128 Then	'Block full. Push into the buffer
							If alphachannel Then
								buffer &= Chr(255) + MkL(sample)
							Else
								buffer &= Chr(255) + Left(MkL(sample), 3)
							End If
							count = 0
							status = 0
						Else
							count += 1
							column += 1
						End If
					Else
						'Found an end for the RLE block
						buffer &= Chr(127 + count)
						If alphachannel Then
							buffer &= MkL(sample)
						Else
							buffer &= Left(MkL(sample), 3)
						End If
						count = 0
						status = 0
					End If
				Case Else	'Non-RLE
					If imagestart[rp + column] = imagestart[rp + column + 1]  Then
						'End of non-RLE block
						buffer &= Chr(count - 1)
						For j As Short = column - count To column - 1
							If alphachannel Then
								buffer &= MkL(imagestart[rp + j])
							Else
								buffer &= Left(MkL(imagestart[rp + j]), 3)
							End If
						Next j
						count = 0
						status = 0
					Else
						If count = 128 Then	'Block full. Push into the buffer
							buffer &= Chr(127)
							For j As Short = column - 128 To column - 1
								If alphachannel Then
									buffer &= MkL(imagestart[rp + j])
								Else
									buffer &= Left(MkL(imagestart[rp + j]), 3)
								End If
							Next j
							count = 0
							status = 0
						Else
							count += 1
							column += 1
						End If
					End If
			End Select
		Loop Until column = iwidth
		
		If column = iwidth Then
			If status = 1 Then
				buffer &= Chr(127 + count)
				If alphachannel Then
					buffer &= MkL(sample)
				Else
					buffer &= Left(MkL(sample), 3)
				End If
			Else
				buffer &= Chr(count - 1)
				For j As Short = column - count To column - 1
					If alphachannel Then
						buffer &= MkL(imagestart[rp + j])
					Else
						buffer &= Left(MkL(imagestart[rp + j]), 3)
					End If
				Next j
			End If
		End If
		
		Put #f, , buffer
	Next i
	
	'Targa v2.0 with no extensions
	buffer = String(8, 0) + "TRUEVISION-XFILE." + Chr(0)
	Put #f, , buffer
	
	Close f
End Sub
